home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO018.dsk / DATA.BASE.bas < prev    next >
BASIC Source File  |  2012-02-16  |  22KB  |  397 lines
  1. 10  REM    D A T A   B A S E<CTRL-J><CTRL-J>
  2. 20  ONERR  GOTO 50
  3. 30  GOSUB 2885:C$ = "H": GOTO 70
  4. 40  REM  <CTRL-J>COMMAND DRIVER<CTRL-J>
  5. 50  PRINT : IF  PEEK(222)  THEN  PRINT D$"CLOSE": PRINT D$"PR#0": INVERSE : PRINT "AN ERROR HAS OCCURRED!";: NORMAL : GOSUB 3330: PRINT :C$ = "X": GOTO 70
  6. 60  PRINT "COMMAND? ";: GET C$: PRINT 
  7. 70 C = 8:Z =  ASC(C$ +"H") -64 -32 *(C$ >"Z"): IF Z >0  AND Z <27  THEN  IF H$(Z) < >"*"  THEN C = Z
  8. 80 T$ = H$(C): GOSUB 3290
  9. 90  ON C GOSUB 120,220,390,480,560,690,1040,1170,1200,1310,110,1400,1480,110,110,1640,1780,1810,2480,2570,2620,110,2760,2780,110,3030
  10. 100  GOTO 40
  11. 110  RETURN 
  12. 120  REM  <CTRL-J>ADD MORE RECORDS<CTRL-J>
  13. 130  IF VF = 0 GOTO 3430
  14. 140  IF VR = VM GOTO 3470
  15. 150  PRINT VM -VR" RECORDS MAY BE ADDED."
  16. 160  PRINT "TO STOP ADDING, PRESS 'RETURN'": PRINT "WHEN ASKED FOR '"FT$(1)"'.": PRINT 
  17. 170  INVERSE : PRINT "RECORD # "VR +1: NORMAL 
  18. 180  FOR I = 1 TO VF: PRINT " "FT$(I) TAB( FM +2);: INPUT ":";T$
  19. 190  IF I = 1  THEN VR = VR +1: IF T$ = ""  THEN VR = VR -1:I = VF: NEXT : GOSUB 3370: GOSUB 3370: GOSUB 3390: GOTO 3250
  20. 200  IF T$ = "/"  THEN T$ = DB$(VR -1,I): GOSUB 3370: PRINT " "FT$(I) TAB( FM +2)":"T$
  21. 210 DB$(VR,I) = T$: NEXT : PRINT : IF VR <VM GOTO 170
  22. 220  REM  <CTRL-J>BEGIN A DATA BASE<CTRL-J>
  23. 230  IF VR GOTO 3450: REM         MUST NOT LOSE DATA.
  24. 240  IF DB  THEN  CLEAR : GOSUB 2950:C$ = "B": GOTO 70
  25. 250  PRINT "IS THIS DATA BASE TO BE THE SAME FORMAT AS ANOTHER DATA BASE ALREADY ON DISK? ";
  26. 260  GOSUB 3350: PRINT : IF N GOTO 310
  27. 270  PRINT "ENTER FILE-NAME (OR '?'):": INPUT "";T$: IF T$ = "?"  THEN  GOSUB 2760: GOTO 250
  28. 280  IF T$ = "" GOTO 3510
  29. 290 FI$ = T$: PRINT D$"OPEN"FI$: PRINT D$"READ"FI$
  30. 300  INPUT VF,FM: FOR J = 1 TO VF: INPUT FT$(J): NEXT : PRINT D$"CLOSE": GOTO 370
  31. 310  PRINT "ENTER A BRIEF NAME FOR EACH FIELD.      PRESS 'RETURN' WHEN FINISHED.": PRINT 
  32. 320  PRINT "FIELD #   FIELD NAME": PRINT "-------   ----------": PRINT :VF = 0:FM = 0
  33. 330  PRINT  TAB( 3 +(VF <9))VF +1; TAB( 11);: INPUT "";T$
  34. 340 T =  LEN(T$): IF T = 0 GOTO 370
  35. 350 VF = VF +1:FT$(VF) = T$: IF T >FM  THEN FM = T
  36. 360  IF VF <16 GOTO 330
  37. 370  IF VF  THEN VM =  INT(3000/VF):DB = 1: DIM DB$(VM,VF)
  38. 380  RETURN 
  39. 390  REM  <CTRL-J>CHANGE DATA IN MEMORY<CTRL-J>
  40. 400  IF VF = 0 GOTO 3430
  41. 410  IF VR = 0 GOTO 3490
  42. 420  GOSUB 3110: GOSUB 3160
  43. 430  PRINT : INPUT "LOOK FOR WHAT VALUE? :";T1$
  44. 440  PRINT : INPUT "CHANGE IT INTO WHAT? :";T2$
  45. 450 J = 0: FOR I = VL TO VH: IF DB$(I,F) = T1$  THEN DB$(I,F) = T2$: PRINT " "I;:J = 1
  46. 460  NEXT : IF J  THEN  PRINT " CHANGED.": RETURN 
  47. 470  GOTO 3270
  48. 480  REM  <CTRL-J>DELETE RECORDS<CTRL-J>
  49. 490  PRINT "(I WILL ASK FOR PERMISSION TO DELETE.)": PRINT 
  50. 500  IF VF = 0 GOTO 3430
  51. 510  IF VR = 0 GOTO 3490
  52. 520  GOSUB 3160
  53. 530  INPUT "TO DELETE THEM, TYPE 'YES':";T$: IF T$ < >"YES" GOTO 3090
  54. 540  IF VH <VR  THEN D = VH +1 -VL: FOR I = VH +1 TO VR: FOR J = 1 TO VF:DB$(I -D,J) = DB$(I,J): NEXT J,I
  55. 550 VR = VR -VH +VL -1: GOTO 3250
  56. 560  REM  <CTRL-J>EXPORT A RANDOM FILE<CTRL-J>
  57. 570  IF VF = 0 GOTO 3430
  58. 580  IF VR = 0 GOTO 3490
  59. 590  PRINT "I CAN CREATE A RANDOM-ACCESS FILE": PRINT "FROM THE "VR" RECORDS NOW IN MEMORY.": PRINT : PRINT "IS THIS WHAT YOU WANT? ";: GOSUB 3350: IF N  THEN  RETURN 
  60. 600  PRINT : PRINT "THE RECORD LENGTH MUST BE AT LEAST": PRINT "... JUST A MOMENT"
  61. 610 L = 0: FOR I = 1 TO VR:Z = VF: FOR J = 1 TO VF:Z = Z + LEN(DB$(I,J)): NEXT : IF L <Z  THEN L = Z
  62. 620  NEXT : GOSUB 3380: GOSUB 3420: PRINT L" BYTES TO HOLD ALL THE DATA."
  63. 630  PRINT : INPUT "WHAT RECORD LENGTH DO YOU WANT? ";W: IF W <L  THEN  PRINT "THAT WOULD NOT WORK!": RETURN 
  64. 640  PRINT "ENTER FILE-NAME TO CREATE:"
  65. 650  INPUT "       ";FR$: IF FR$ = FI$  THEN  PRINT "NO, I WON'T OVERWRITE THAT!": RETURN 
  66. 660  IF FR$ = ""  OR FR$ = "?"  THEN  PRINT D$"CAT": GOTO 640
  67. 665  FOR J = 1 TO VF:DB$(0,J) = "": NEXT :DB$(0,1) =  STR$(VR)
  68. 670  PRINT D$"OPEN"FR$",L"W
  69. 673  FOR I = 0 TO VR: PRINT D$"WRITE"FR$",R"I: PRINT  SPC( W)"": PRINT D$"WRITE"FR$",R"I: FOR J = 1 TO VF: PRINT DB$(I,J): NEXT : NEXT : PRINT D$"CLOSE"FR$
  70. 680  PRINT VR" RECORDS WRITTEN.": RETURN 
  71. 690  REM  <CTRL-J>FIND DATA IN MEMORY<CTRL-J>
  72. 700  IF VF = 0 GOTO 3430
  73. 710  IF VR = 0 GOTO 3490
  74. 720  GOSUB 3110: GOSUB 3160
  75. 730  PRINT : INPUT "LOOK FOR WHAT VALUE? :";T1$:T1 =  LEN(T1$): IF T1 = 0  THEN T1 = 1
  76. 740  PRINT "FOUND IN";:C = 0
  77. 750  FOR I = VL TO VH:DB$(I,0) = "N"
  78. 760  IF  LEFT$(DB$(I,F),T1) = T1$  THEN :DB$(I,0) = "Y": PRINT " "I;:C = C +1
  79. 770  NEXT : IF C = 0  THEN  PRINT " ... NONE!": RETURN 
  80. 780  PRINT ".": PRINT : PRINT "ENTER AN ACTION FOR THESE RECORDS:": PRINT 
  81. 790  PRINT "  C - CHANGE '"T1$"'.": PRINT "  D - DELETE THEM."
  82. 800  PRINT "  L - LIST THEM": PRINT "  U - UPDATE THEM"
  83. 810  PRINT : PRINT "ACTION: ";: GET C$: PRINT C$: IF C$ < >CR$  THEN  PRINT 
  84. 820  IF C$ = "C" GOTO 870
  85. 830  IF C$ = "D" GOTO 910
  86. 840  IF C$ = "L" GOTO 980
  87. 850  IF C$ = "U" GOTO 1020
  88. 860  GOTO 3090
  89. 870  REM  <CTRL-J>CHANGE FOUND STRING<CTRL-J>
  90. 880  PRINT "  CHANGE: "T1$: INPUT "      TO: ";T2$: PRINT : PRINT "  CHANGED ";
  91. 890  FOR I = VL TO VH: IF DB$(I,0) = "Y"  THEN  PRINT " "I;:DB$(I,F) = T2$
  92. 900  NEXT : PRINT ".": RETURN 
  93. 910  REM  <CTRL-J>DELETE FOUND RECORDS<CTRL-J>
  94. 920  INPUT "TO DELETE THEM, TYPE 'YES':";T$: IF T$ < >"YES" GOTO 3090
  95. 930 I = VL:C = 0: PRINT "DELETING";:
  96. 940  IF DB$(I +C,0) = "Y"  THEN  PRINT " "I +C;:C = C +1: GOTO 940
  97. 950  IF I +C >VR  THEN VR = I -1: PRINT ".": GOTO 3250
  98. 960  IF C  THEN  FOR J = 0 TO VF:DB$(I,J) = DB$(I +C,J): NEXT 
  99. 970 I = I +1: GOTO 940
  100. 980  REM  <CTRL-J>LIST FOUND RECORDS<CTRL-J>
  101. 990  PRINT : PRINT "SPACE BAR = PROCEED; RETURN = QUIT.": PRINT 
  102. 1000  FOR I = VL TO VH: IF DB$(I,0) = "Y"  THEN  GOSUB 3220: GET T$: PRINT : IF T$ = CR$  THEN I = VH
  103. 1010  NEXT : RETURN 
  104. 1020  REM  <CTRL-J>UPDATE FOUND RECORDS<CTRL-J>
  105. 1030  GOTO 2660
  106. 1040  REM  <CTRL-J>GET FILE FROM DISK<CTRL-J>
  107. 1050  IF VR GOTO 3450
  108. 1060  IF DB  THEN  CLEAR : GOSUB 2950:C$ = "G": GOTO 70
  109. 1070  PRINT "ENTER FILE NAME (OR '?'):"
  110. 1080  INPUT "       ";FI$: IF FI$ = "?"  THEN  GOSUB 2760: GOTO 1070
  111. 1090  IF FI$ = "" GOTO 3510
  112. 1100  PRINT D$"OPEN"FI$: PRINT D$"READ"FI$
  113. 1110  INPUT VF,FM: FOR J = 1 TO VF: INPUT FT$(J): NEXT 
  114. 1120  INPUT VM,VR:DB = 1: DIM DB$(VM,VF)
  115. 1130  PRINT : PRINT VR" RECORDS ON DISK.": PRINT 0 SPC(  LEN( STR$(VR)))"RECORDS IN MEMORY."
  116. 1140  FOR I = 1 TO VR: FOR J = 1 TO VF: INPUT DB$(I,J): NEXT 
  117. 1150  GOSUB 3370: PRINT I: NEXT 
  118. 1160  PRINT D$"CLOSE": RETURN 
  119. 1170  REM  <CTRL-J>PRINT COMMAND MENU<CTRL-J>
  120. 1180  FOR I = 1 TO 26: IF H$(I) < >"*"  AND I < >8  AND I < >24  THEN  PRINT  TAB( SW/4) CHR$(64 +I)" - "H$(I)
  121. 1190  NEXT : RETURN 
  122. 1200  REM  <CTRL-J>INFO ABOUT PROGRAM<CTRL-J>
  123. 1210  PRINT "I LOOK AFTER ANY TYPE OF DATA, BUT I CANREAD ONLY FILES WHICH I HAVE CREATED.": PRINT 
  124. 1220  PRINT "I LEARN THE NAMES OF FIELDS FROM YOU,   THEN YOU MAY ENTER DATA, FIELD BY FIELD."
  125. 1230  PRINT "A VARIETY OF FUNCTIONS ARE BUILT-IN,    AND THE PROGRAM IS EASY TO CUSTOMIZE."
  126. 1240  PRINT : PRINT "VF       - NUMBER OF FIELDS"
  127. 1250  PRINT "FT$(J)   - NAME OF EACH FIELD"
  128. 1260  PRINT "VM       - MAX # OF RECORDS"
  129. 1270  PRINT "VR       - # REC IN MEMORY"
  130. 1280  PRINT "DB$(I,J) - THE DATA BASE"
  131. 1290  PRINT : PRINT "MANY ERROR-CHECKS ARE BUILT IN FOR YOU. STUDY EXISTING ROUTINES & WRITE MORE."
  132. 1300  RETURN 
  133. 1310  REM  <CTRL-J>JOURNAL OF RECORDS<CTRL-J>
  134. 1320  IF VF = 0 GOTO 3430
  135. 1330  IF VR = 0 GOTO 3490
  136. 1340 I = 0:Z =  INT((SW +1 -VF)/VF)
  137. 1350  IF I = 20 * INT(I/20)  THEN  HOME : INVERSE : FOR J = 1 TO VF: PRINT  LEFT$(FT$(J) +BL$,Z) SPC( J <VF);: NEXT : PRINT : NORMAL 
  138. 1360 I = I +1: FOR J = 1 TO VF: PRINT  LEFT$(DB$(I,J) +BL$,Z) SPC( J <VF);: NEXT : PRINT 
  139. 1370  IF I = VR  OR I = 20 * INT(I/20)  THEN  PRINT "'ESC' TO QUIT; ANY KEY TO CONTINUE.";: GET Z$: PRINT : IF Z$ =  CHR$(27)  THEN I = VR
  140. 1380  IF I <VR GOTO 1350
  141. 1390  RETURN 
  142. 1400  REM  <CTRL-J>LIST SOME RECORDS<CTRL-J>
  143. 1410  IF VF = 0 GOTO 3430
  144. 1420  IF VR = 0 GOTO 3490
  145. 1430  GOSUB 3250: INPUT "START LISTING AT WHICH? ";I
  146. 1440  IF I <1  OR I >VR GOTO 1430
  147. 1450  PRINT : PRINT "SPACE BAR = PROCEED; RETURN = QUIT.": PRINT 
  148. 1460  GOSUB 3220: GET T$: PRINT : IF I <VR  AND T$ < >CR$  THEN I = I +1: GOTO 1460
  149. 1470  RETURN 
  150. 1480  REM  <CTRL-J>MERGE 2 DATA BASES<CTRL-J>
  151. 1490  IF VF = 0 GOTO 3430
  152. 1500  IF VR = 0 GOTO 3490
  153. 1510  PRINT "ENTER FILE NAME (OR '?'):"
  154. 1520  INPUT "       ";FM$: IF FM$ = "?"  THEN  GOSUB 2760: GOTO 1510
  155. 1530  IF FM$ = "" GOTO 3510
  156. 1540  PRINT D$"OPEN"FM$: PRINT D$"READ"FM$
  157. 1550  INPUT Z: IF Z = VF  THEN  INPUT Z: IF Z = FM GOTO 1570
  158. 1560  PRINT D$"CLOSE"FM$:T$ = "'" +FM$ +"' IS NOT THE SAME" +CR$ +"FORMAT AS '" +FI$ +"'.": GOTO 3530
  159. 1570  FOR J = 1 TO VF: INPUT Z$: IF Z$ < >FT$(J)  THEN J = VF: NEXT : GOTO 1560
  160. 1580  NEXT : INPUT Z: INPUT Z: IF VR +Z >VM  THEN  PRINT D$"CLOSE"FM$:T$ = "NO ROOM TO ADD " + STR$(Z) +" RECORDS.": GOTO 3530
  161. 1590  PRINT : PRINT VR" RECORDS ALREADY IN MEMORY."
  162. 1600  PRINT Z" MORE RECORDS ON DISK.": IF Z <1  THEN  RETURN 
  163. 1610  PRINT 0 SPC(  LEN( STR$(VR +Z)))"RECORDS NOW IN MEMORY.": FOR I = VR +1 TO VR +Z: FOR J = 1 TO VF: INPUT DB$(I,J): NEXT 
  164. 1620  GOSUB 3370: PRINT I: NEXT :VR = VR +Z
  165. 1630  PRINT D$"CLOSE"FM$: RETURN 
  166. 1640  REM  <CTRL-J>PUT DATA BASE TO DISK<CTRL-J>
  167. 1650  IF VF = 0 GOTO 3430
  168. 1660  IF VR = 0 GOTO 3490
  169. 1670  IF FI$ = "" GOTO 1710
  170. 1680  PRINT "THE CURRENT FILE-NAME IS": PRINT "       "FI$: PRINT 
  171. 1690  PRINT "DO YOU WANT TO WRITE THAT FILE? ";
  172. 1700  GOSUB 3350: IF Y GOTO 1730
  173. 1710  PRINT : PRINT "ENTER FILE-NAME (OR '?'):": INPUT "       ";FI$
  174. 1720  IF FI$ = "?"  THEN  GOSUB 2760: GOTO 1710
  175. 1730  PRINT D$"OPEN"FI$: PRINT D$"WRITE"FI$
  176. 1740  PRINT VF: PRINT FM: FOR J = 1 TO VF: PRINT FT$(J): NEXT 
  177. 1750  PRINT VM: PRINT VR: FOR I = 1 TO VR: FOR J = 1 TO VF: PRINT DB$(I,J): NEXT : NEXT 
  178. 1760  PRINT D$"CLOSE"FI$: PRINT : PRINT VR" RECORDS WRITTEN.": RETURN 
  179. 1770  REM  <CTRL-J>QUIT<CTRL-J>
  180. 1780  IF VR  THEN  PRINT "TO END GRACEFULLY, USE THE 'Z' COMMAND. ": GOTO 3450
  181. 1790  PRINT "DATA BASE - END OF RUN."
  182. 1800  TEXT : GOSUB 3370: POKE 216,0: END 
  183. 1810  REM  <CTRL-J>REPORT ON DATA BASE<CTRL-J>
  184. 1820  IF VF = 0 GOTO 3430
  185. 1830  IF VR = 0 GOTO 3490
  186. 1840  IF RG  THEN  PRINT "SAME FORMAT AS THE PREVIOUS REPORT? ";: GOSUB 3350: IF (Y)  THEN  INVERSE : PRINT  RIGHT$(" " + STR$(J),2);: NORMAL : PRINT FT$(J): NEXT : GOTO 2050
  187. 1850 Z = RS: IF Z = 0  THEN  INPUT "PRINTER SLOT: ";Z: IF Z <1  OR Z >7  THEN  RETURN 
  188. 1860 RS = Z:Z = RW: IF Z = 0  THEN  INPUT "PAPER WIDTH:  ";Z: IF Z <20  THEN  RETURN 
  189. 1870 RW = Z:Z = RD: IF Z = 0  THEN  INPUT "PAPER DEPTH:  ";Z: IF Z <20  THEN  RETURN 
  190. 1880 RD = Z: HOME : INVERSE : PRINT "  FIELD-NAME   PRINT   WIDTH   # DEC": NORMAL 
  191. 1890 Z =  INT((RW -VF)/VF): FOR J = 1 TO VF: VTAB 4 +J: INVERSE : PRINT  RIGHT$(" " + STR$(J),2);: NORMAL : PRINT  LEFT$(FT$(J),15) TAB( 18)"Y" TAB( 25)Z TAB( 34)"A":FW%(J) = Z:FD%(J) =  -1: NEXT 
  192. 1900  VTAB 6 +VF: GOSUB 3390:VO = 0: PRINT "ARE SOME FIELDS TO BE OMITTED? ";: GOSUB 3350: IF N GOTO 1960
  193. 1910  VTAB 6 +VF: GOSUB 3390: PRINT "TYPE 'N' TO OMIT; 'Y' TO PRINT."
  194. 1920  FOR J = 1 TO VF: VTAB 4 +J: HTAB 18: GOSUB 3350: IF N  THEN FW%(J) = 0:VO = VO +1: GOSUB 3380: HTAB 24: GOSUB 3420
  195. 1930  NEXT : PRINT : IF VO = VF  THEN  RETURN 
  196. 1940  IF VO  THEN Z = VF -VO:Z =  INT((RW -Z)/Z): FOR J = 1 TO VF: IF FW%(J)  THEN  VTAB 4 +J: HTAB 25: PRINT Z:FW%(J) = Z
  197. 1950  NEXT 
  198. 1960  VTAB 6 +VF: GOSUB 3390: PRINT "WILL YOU ENTER FIELD-WIDTHS? ";: GOSUB 3350: IF N GOTO 2020
  199. 1970  VTAB 6 +VF: GOSUB 3390: PRINT "ENTER WIDTH FOR EACH FIELD.": PRINT "DON'T USE MORE THAN "RW -VF +VO +1" COLUMNS. ":Z = 0
  200. 1980  FOR J = 1 TO VF: IF FW%(J) = 0 GOTO 2010
  201. 1990  VTAB 4 +J: HTAB 25: INPUT "";Z$:I =  VAL(Z$): IF I >0  THEN FW%(J) = I
  202. 2000  GOSUB 3370: HTAB 25: PRINT FW%(J) TAB( 34)"A"
  203. 2010 Z = Z +FW%(J): NEXT : IF Z >RW -VF +VO +1  THEN  VTAB 7 +VF: INVERSE : PRINT "THAT'S MORE COLUMNS THAN FIT THE PAPER!";: GET Z$: NORMAL : PRINT : GOTO 1970
  204. 2020  VTAB 6 +VF: GOSUB 3390: PRINT "ENTER # OF DECIMALS FOR NUMERIC FIELDS.": PRINT "LEAVE THE 'A' THERE FOR ALPHANUMERIC."
  205. 2030  FOR J = 1 TO VF:I = FW%(J): IF I  THEN  VTAB 4 +J: HTAB 34: GET Z$: IF Z$ > = "0"  AND Z$ <"7"  THEN Z =  VAL(Z$): IF Z <I  THEN  PRINT Z:FD%(J) = Z
  206. 2040  NEXT : PRINT 
  207. 2050  VTAB 6 +VF: GOSUB 3390: PRINT "PRINT ";: INVERSE : PRINT "ALL";: NORMAL : PRINT " OR ";: INVERSE : PRINT "SELECTED";: NORMAL : PRINT " RECORDS? (A / S): ";
  208. 2060  GET Z$: IF Z$ < >"A"  AND Z$ < >"S" GOTO 2060
  209. 2070  PRINT Z$:RC = Z$ = "S": IF RC = 0 GOTO 2110
  210. 2080  PRINT "SELECT BASED ON WHICH FIELD? (1-"VF;: INPUT "): ";Z$
  211. 2090 RC =  VAL(Z$): IF RC <1  OR RC >VF GOTO 2050
  212. 2100  VTAB 6 +VF: GOSUB 3390: PRINT "ENTER MIN & MAX FOR '"FT$(RC)"'.": INPUT "MINIMUM: ";RL$:RL =  VAL(RL$): INPUT "MAXIMUM: ";RH$:RH =  VAL(RH$)
  213. 2110  VTAB 6 +VF: GOSUB 3390: PRINT "ENTER REPORT TITLE. I WILL CENTRE IT.": INPUT "";RT$
  214. 2120 Z = 0:I = 0: FOR J = 1 TO VF:FT(J) = 0:X = FW%(J):I = I + SGN(X):Z = Z +X: NEXT :RG = 1: IF I >1  THEN RG =  INT((RW -Z)/(I -1))
  215. 2130  VTAB 6 +VF: GOSUB 3390: PRINT "PRESS ANY KEY TO PRINT, 'ESC' TO QUIT. ";
  216. 2140  GET Z$: IF Z$ =  CHR$(27)  THEN  RETURN 
  217. 2150  PRINT : PRINT D$"PR#"RS:RP = 0:RL = RD: FOR I = 1 TO VR: IF RC = 0 GOTO 2200
  218. 2160  IF FD%(RC) <0 GOTO 2190
  219. 2170 Z =  VAL(DB$(I,RC)): IF Z <RL  OR Z >RH GOTO 2370
  220. 2180  GOTO 2200
  221. 2190 Z$ = DB$(I,RC): IF Z$ <RL$  OR Z$ >RH$ GOTO 2370
  222. 2200  IF RL +9 <RD GOTO 2290
  223. 2210  IF RL <RD  THEN  PRINT :RL = RL +1: GOTO 2210
  224. 2220 RP = RP +1:Z = (RW - LEN(RT$))/2: IF Z > = 1  THEN  PRINT  SPC( Z);
  225. 2230  PRINT RT$: PRINT "FILE: "FI$;:Z = RW -13 - LEN(FI$): IF Z > = 1  THEN  PRINT  SPC( Z);
  226. 2240  PRINT "PAGE "RP: PRINT :X = 0: FOR J = 1 TO VF:Z = FW%(J): IF Z = 0 GOTO 2280
  227. 2250  IF X  THEN  PRINT  SPC( RG)
  228. 2260 X = 1: IF FD%(J) <0  THEN  PRINT  LEFT$(FT$(J) +BL$,Z);: GOTO 2280
  229. 2270  PRINT  RIGHT$(BL$ + LEFT$(FT$(J),Z),Z);
  230. 2280  NEXT : PRINT :RL = 5: PRINT 
  231. 2290  PRINT :X = 0: FOR J = 1 TO VF:Z = FW%(J): IF Z = 0 GOTO 2360
  232. 2300  IF X  THEN  PRINT  SPC( RG)
  233. 2310 X = 1:D = FD%(J): IF D <0  THEN  PRINT  LEFT$(DB$(I,J) +BL$,Z);: GOTO 2360
  234. 2320 Y =  VAL(DB$(I,J)):FT(J) = FT(J) +Y:Y =  INT(Y *10 ^D +.5):Z$ =  STR$( ABS(Y))
  235. 2330  IF  LEN(Z$) < = D  THEN Z$ = "0" +Z$: GOTO 2330
  236. 2340  IF Y <0  THEN Z$ = "-" +Z$
  237. 2350  PRINT  RIGHT$(BL$ + LEFT$(Z$, LEN(Z$) -D),Z - SGN(D) -D);: IF D  THEN  PRINT "." RIGHT$(Z$,D);
  238. 2360  NEXT : PRINT :RL = RL +2
  239. 2370  IF  PEEK(KB) = 155  THEN I =  PEEK(KS):I = VR
  240. 2380  NEXT : IF RP = 0 GOTO 2470
  241. 2390  PRINT " ":RL = RL +1:X = 0: FOR J = 1 TO VF:Z = FW%(J): IF Z = 0 GOTO 2460
  242. 2400  IF X  THEN  PRINT  SPC( RG)
  243. 2410 X = 1:D = FD%(J): IF D <0  THEN  PRINT  SPC( FW%(J)): GOTO 2460
  244. 2420 Y =  INT(FT(J) *10 ^D +.5):Z$ =  STR$( ABS(Y))
  245. 2430  IF  LEN(Z$) < = D  THEN Z$ = "0" +Z$: GOTO 2430
  246. 2440  IF Y <0  THEN Z$ = "-" +Z$
  247. 2450  PRINT  RIGHT$(BL$ + LEFT$(Z$, LEN(Z$) -D),Z - SGN(D) -D);: IF D  THEN  PRINT "." RIGHT$(Z$,D);
  248. 2460  NEXT : FOR I = RL TO RD: PRINT : NEXT 
  249. 2470  PRINT D$"PR#0": RETURN 
  250. 2480  REM  <CTRL-J>STATISTICS<CTRL-J>
  251. 2490  IF DB = 0  THEN  PRINT "THERE IS NOTHING IN MEMORY.": RETURN 
  252. 2500  PRINT "YOU HAVE A DATA BASE OF "VF" FIELDS."
  253. 2510  PRINT : PRINT VR" RECORDS ARE IN MEMORY."
  254. 2520  PRINT : PRINT VM -VR" RECORDS MAY BE ADDED,"
  255. 2530  PRINT D$"FRE":I = 256 *( PEEK(112) - PEEK(110)) + PEEK(111) - PEEK(109): IF I <0  THEN I = I +65536
  256. 2540  PRINT : PRINT "IF "I" BYTES WILL CONTAIN THEM."
  257. 2550  IF  LEN(FI$)  THEN  PRINT : PRINT "THE CURRENT FILE-NAME IS": PRINT "'"FI$"'."
  258. 2560  RETURN 
  259. 2570  REM  <CTRL-J>TOTAL NUMERIC FIELDS<CTRL-J>
  260. 2580  IF VF = 0 GOTO 3430
  261. 2590  IF VR = 0 GOTO 3490
  262. 2600  FOR J = 1 TO VF:Z = 0: FOR I = 1 TO VR:Z = Z + VAL(DB$(I,J)): NEXT :FT(J) = Z: NEXT 
  263. 2610  FOR J = 1 TO VF: PRINT " "FT$(J) TAB( FM +2)": "FT(J): NEXT : RETURN 
  264. 2620  REM  <CTRL-J>UPDATE FIELD-BY-FIELD<CTRL-J>
  265. 2630  IF VF = 0 GOTO 3430
  266. 2640  IF VR = 0 GOTO 3490
  267. 2650  GOSUB 3160:C = 0
  268. 2660  REM  <CTRL-J>UPDATE ALL(C=0) OR                 SELECTED(C>0)<CTRL-J>
  269. 2670  PRINT : PRINT "KEY NEW DATA TO CHANGE A FIELD;         PRESS RETURN TO RETAIN CURRENT DATA."
  270. 2680  PRINT : PRINT "PRESS ANY KEY WHEN READY. ";: GET T$: PRINT 
  271. 2690  FOR I = VL TO VH: IF C  THEN  IF DB$(I,0) = "N" GOTO 2750
  272. 2700  HOME : GOSUB 3220: VTAB 4
  273. 2710  FOR J = 1 TO VF: PRINT " "FT$(J) TAB( FM +2)":";: INPUT "";T$: IF T$ = "/"  THEN DB$(I,J) = DB$(I -1,J): GOTO 2730
  274. 2720  IF  LEN(T$)  THEN DB$(I,J) = T$: GOTO 2740
  275. 2730  GOSUB 3370: PRINT " "FT$(J) TAB( FM +2)":"DB$(I,J)
  276. 2740  NEXT 
  277. 2750  NEXT : RETURN 
  278. 2760  REM  <CTRL-J>WHAT IS ON DISK?<CTRL-J>
  279. 2770  PRINT D$"CAT,TTXT": RETURN 
  280. 2780  REM  <CTRL-J>'XPLAIN' AN ERROR.<CTRL-J>
  281. 2790 I =  PEEK(222):J =  PEEK(218) + PEEK(219) *256
  282. 2800  IF I = 0  AND J = 0  THEN  PRINT "THERE IS NO INDICATION OF ERROR.": RETURN 
  283. 2810  PRINT "ERROR-CODE "I" WAS CAUSED IN LINE "J"."
  284. 2820  FOR C = 1 TO EC(0): IF I = EC(C)  THEN  PRINT : PRINT "THIS MEANS: "EM$(C):C = EC(0)
  285. 2830  NEXT : PRINT 
  286. 2840  IF I = 5  OR I = 254  THEN  PRINT "I BET YOU ENTERED A WRONG FILE-NAME!"
  287. 2850  POKE 222,0: POKE 218,0: POKE 219,0
  288. 2860  PRINT : PRINT "THOSE ERROR-INDICATORS ARE NOW RESET."
  289. 2870  RETURN 
  290. 2880  REM  <CTRL-J>COVER AND CREDITS<CTRL-J>
  291. 2885  PRINT  CHR$(21)
  292. 2890  TEXT : HOME : NORMAL : SPEED= 255: COLOR= 15
  293. 2900  HLIN 0,39 AT 0: HLIN 0,39 AT 1: HLIN 0,39 AT 46: HLIN 0,39 AT 47: VLIN 2,45 AT 0: VLIN 2,45 AT 39
  294. 2910  VTAB 8: HTAB 12: PRINT "D A T A   B A S E"
  295. 2920  VTAB 12: HTAB 9: PRINT "A FILE MANAGEMENT TOOL": PRINT : HTAB 9: PRINT "BY KEITH FALKNER. V1.5"
  296. 2930  POKE  -16368,0: FOR I = 1 TO 500: IF  PEEK( -16384) >127  THEN  POKE  -16368,0:I = 500
  297. 2940  NEXT : HOME 
  298. 2950  REM  <CTRL-J>INITIALIZE<CTRL-J>
  299. 2960 I = 0:J = 0:D = 0:N = 0:X = 0:Y = 0:Z = 0:VR = 0:VF = 0:D$ =  CHR$(4):CR$ =  CHR$(13):KB = 49152:KS = KB +16:BL$ = "     ": REM  5 SPACES
  300. 2970 BL$ = BL$ +BL$: IF  LEN(BL$) <40 GOTO 2970
  301. 2975 SW = 40: IF  PEEK(65535) <240  THEN  IF  PEEK(49248) <128  THEN SW = 80: PRINT D$"PR#3"
  302. 2980  DIM H$(26): RESTORE : FOR I = 1 TO 26: READ H$(I): NEXT 
  303. 2990  DIM EC(32),EM$(32):EC(0) = 32
  304. 3000  FOR I = 1 TO EC(0): READ EC(I),EM$(I): NEXT 
  305. 3010 Z = 16: DIM FT$(Z),FW%(Z),FD%(Z),FT(Z)
  306. 3020  POKE 218,0: POKE 219,0: POKE 222,0: RETURN 
  307. 3030  REM  <CTRL-J>ZERO MEMORY!<CTRL-J>
  308. 3040  IF DB = 0 GOTO 3070
  309. 3050  INPUT "TO EMPTY MEMORY, TYPE 'YES':";T$: IF T$ < >"YES"  AND T$ < >"yes" GOTO 3090
  310. 3060  CLEAR : GOSUB 2950:C$ = "Z": GOTO 70
  311. 3070  PRINT "MEMORY IS CLEARED.": PRINT : PRINT "DO YOU WANT TO QUIT? ";: GOSUB 3350: IF Y  THEN  PRINT : GOTO 1780
  312. 3080  RETURN 
  313. 3090  REM  <CTRL-J>REASSURING MESSAGE<CTRL-J>
  314. 3100  PRINT : PRINT "O.K. NOTHING HAS BEEN LOST.": RETURN 
  315. 3110  REM  <CTRL-J>WHICH FIELD, PLEASE?<CTRL-J>
  316. 3120  INPUT "ENTER FIELD-NAME: ";T$
  317. 3130 F = 0: FOR I = 1 TO VF: IF T$ = FT$(I)  THEN F = I:I = VF
  318. 3140  NEXT : IF F  THEN  RETURN 
  319. 3150  PRINT "TRY AGAIN, PLEASE.": FOR I = 1 TO VF: PRINT FT$(I): NEXT : GOTO 3120
  320. 3160  REM  <CTRL-J>DEFINE A RANGE<CTRL-J>
  321. 3170  GOSUB 3250
  322. 3180  INPUT "  LOW END OF RANGE: ";VL
  323. 3190  INPUT " HIGH END OF RANGE: ";VH
  324. 3200  IF VL <1  OR VH >VR  THEN  PRINT : PRINT "TRY AGAIN, PLEASE.": PRINT : GOTO 3170
  325. 3210  RETURN 
  326. 3220  REM  <CTRL-J>LIST RECORD # I<CTRL-J>
  327. 3230  INVERSE : PRINT "RECORD "I;: NORMAL : PRINT 
  328. 3240  FOR J = 1 TO VF: PRINT " "FT$(J) TAB( FM +2)":"DB$(I,J): NEXT : RETURN 
  329. 3250  REM  <CTRL-J>THERE ARE ### RECORDS<CTRL-J>
  330. 3260  PRINT "THERE ARE "VR" RECORDS.": RETURN 
  331. 3270  REM  <CTRL-J>T1$ WAS NOT FOUND<CTRL-J>
  332. 3280  PRINT : PRINT "'"T1$"' WAS NOT FOUND.": RETURN 
  333. 3290  REM  <CTRL-J>ENTITLE SCREEN<CTRL-J>
  334. 3300 T = SW/2 - LEN(T$)/2: TEXT : HOME 
  335. 3310  PRINT  TAB( T)T$: FOR T = 1 TO SW: PRINT "-";: NEXT : PRINT : POKE 34,2: RETURN 
  336. 3320  REM  <CTRL-J>GET A KEY<CTRL-J>
  337. 3330  POKE KS,0: GET K$: RETURN 
  338. 3340  REM  <CTRL-J>GET & PRINT Y OR N<CTRL-J>
  339. 3350  GOSUB 3330:Y = K$ = "Y"  OR  ASC(K$) = 121:N = K$ = "N"  OR  ASC(K$) = 110: IF Y = N GOTO 3350
  340. 3360  PRINT K$: RETURN 
  341. 3370  REM  <CTRL-J>MOVE THE CURSOR UP<CTRL-J>
  342. 3380  CALL  -998: RETURN 
  343. 3390  REM  <CTRL-J>CLEAR TO END OF SCREEN<CTRL-J>
  344. 3400  CALL  -958: RETURN 
  345. 3410  REM  <CTRL-J>CLEAR TO END OF LINE<CTRL-J>
  346. 3420  CALL  -868: RETURN 
  347. 3430  REM  <CTRL-J>ERROR - UNDEFINED SETUP<CTRL-J>
  348. 3440 T$ = "THE DATA BASE HAS NOT BEEN DEFINED;     USE 'B' TO BEGIN OR 'G' TO GET ONE.": GOTO 3530
  349. 3450  REM  <CTRL-J>ERROR - DATA NOT SAVED<CTRL-J>
  350. 3460 T$ =  STR$(VR) +" RECORDS IN MEMORY WOULD BE LOST.": GOTO 3530
  351. 3470  REM  <CTRL-J>ERROR - MEMORY IS FULL<CTRL-J>
  352. 3480 T$ = "MEMORY IS FULL, WITH " + STR$(VR) +" RECORDS.": GOTO 3530
  353. 3490  REM  <CTRL-J>ERROR - NO DATA<CTRL-J>
  354. 3500 T$ = "THERE ARE NO RECORDS IN MEMORY.": GOTO 3530
  355. 3510  REM  <CTRL-J>I NEEDED A FILE-NAME<CTRL-J>
  356. 3520 T$ = "INVALID FILE-NAME.": GOTO 3530
  357. 3530  REM  <CTRL-J>GENERAL ERROR ROUTINE<CTRL-J>
  358. 3540  INVERSE : PRINT "E R R O R": PRINT  CHR$(7): NORMAL : PRINT T$: PRINT : RETURN 
  359. 3550  REM  <CTRL-J>FUNCTION DESCRIPTIONS<CTRL-J>
  360. 3560  DATA  ADD NEW RECORDS,BUILD A NEW DATA BASE,CHANGE RECORDS IN MEMORY,DELETE RECORDS,EXPORT A RANDOM FILE
  361. 3570  DATA  FIND DATA IN RECORDS,GET DATA BASE FROM DISK,SELECT A ROUTINE BY ITS LETTER,INFO ABOUT PROGRAM,JOURNAL LIST
  362. 3580  DATA  *,LIST SOME RECORDS,MERGE 2 DATA BASES,*,*
  363. 3590  DATA  PUT DATA BASE ON DISK,QUIT,REPORT ON PRINTER,STATISTICS,TOTAL NUMERIC FIELDS
  364. 3600  DATA  UPDATE FIELD-BY-FIELD,*,WHAT'S ON THE DISK,EXPLANATION OF ERROR,*
  365. 3610  DATA  ZERO CONTENTS OF MEMORY
  366. 3620  DATA  1,-LANGUAGE NOT FOUND
  367. 3630  DATA  2,-RANGE ERROR
  368. 3640  DATA  3,-RANGE ERROR
  369. 3650  DATA  4,-WRITE PROTECTED
  370. 3660  DATA  5,-END OF DATA
  371. 3670  DATA  6,-FILE NOT FOUND
  372. 3680  DATA  7,-VOLUME MISMATCH
  373. 3690  DATA  8,-I/O ERROR
  374. 3700  DATA  9,-DISK FULL
  375. 3710  DATA  10,-FILE LOCKED
  376. 3720  DATA  11,-SYNTAX ERROR
  377. 3730  DATA  12,-NO BUFFERS AVAILABLE
  378. 3740  DATA  13,-FILE TYPE MISMATCH
  379. 3750  DATA  14,-PROGRAM TOO LARGE
  380. 3760  DATA  15,-NOT DIRECT COMMAND
  381. 3770  DATA  0,NEXT WITHOUT FOR
  382. 3780  DATA  16,SYNTAX
  383. 3790  DATA  22,RETURN WITHOUT GOSUB
  384. 3800  DATA  42,OUT OF DATA
  385. 3810  DATA  53,ILLEGAL QUANTITY
  386. 3820  DATA  69,OVERFLOW
  387. 3830  DATA  77,OUT OF MEMORY
  388. 3840  DATA  90,UNDEFINED STATEMENT
  389. 3850  DATA  107,BAD SUBSCRIPT
  390. 3860  DATA  120,REDIMENSIONED ARRAY
  391. 3870  DATA  133,DIVISION BY ZERO
  392. 3880  DATA  163,TYPE MISMATCH
  393. 3890  DATA  176,STRING TOO LONG
  394. 3900  DATA  191,FORMULA TOO COMPLEX
  395. 3910  DATA  224,UNDEFINED FUNCTION
  396. 3920  DATA  254,BAD RESPONSE TO 'INPUT'
  397. 3930  DATA  255,CTRL-C INTERRUPT